#!c:/perl/bin/perl.exe
##########################################################################################################################
##### a script to add object permissions for Users of Wigan-Warriors.com
##########################################################################################################################

##########################################################################################################################
######  TODO list  #######################################################################################################
##########################################################################################################################
##########################################################################################################################

##########################################################################################################################
###### Bug list
##########################################################################################################################
##########################################################################################################################

##########################################################################################################################
# Includes
##########################################################################################################################

use lib qw(../cgi-bin);
use WiganRL;
use WiganRL::DataObject::Avitem;

use DBI;
use DBD::mysql;

use Getopt::Long;

use strict;
#use warnings;
local $SIG{__WARN__} = \&Carp::cluck;  #full call back trace

$|++;  #unbuffered

##########################################################################################################################
# class and database setup
##########################################################################################################################

my $cfg= WiganRL::DataObject->load_config('../cgi-bin/wiganrl.ini');
my $dbh= Diva::DB->new();
$dbh->set( {
	DATABASE_NAME       => $cfg->val('database', 'DATABASE_NAME'),
	DATABASE_SERVER     => $cfg->val('database', 'DATABASE_SERVER'),
	DATABASE_USERNAME   => $cfg->val('database', 'DATABASE_USERNAME'),
	DATABASE_PASSWORD   => $cfg->val('database', 'DATABASE_PASSWORD'),
	DATABASE_TYPE       => $cfg->val('database', 'DATABASE_TYPE'),
	} );
$dbh->connect();
WiganRL::DataObject->dbh($dbh);
WiganRL::Search->dbh($dbh);
WiganRL::DataObject->init_class('WWCOM');  #loads contenttypes
WiganRL::DataObject->site_seasonid(WiganRL::DataObject::Season->getSeasonID());  #current season
WiganRL::DataObject::View->nobjs_hot($cfg->val('forums', 'NOBJS_HOT'));
WiganRL::DataObject::View->default_forum($cfg->val('forums', 'DEFAULT_FORUM'));

##########################################################################################################################
# get arguments
##########################################################################################################################

my $ndocs= 10000;
GetOptions ('ndocs=i' => \$ndocs);

##########################################################################################################################
# Start indexing
##########################################################################################################################

use Lingua::EN::Tagger;

my $t= Lingua::EN::Tagger->new(stem => 1, weight_noun_phrases => 0, longest_noun_phrase => 3, unknown_word_tag => '');

##########################################################################################################################
# Load global word list
##########################################################################################################################

my $global_word_list= {};
my ($sth,$rv)= $dbh->get(['SEARCH_TERMLIST'],['PK_SEARCHTERM_ID','SEARCH_TERM','SEARCH_TERMFREQUENCY']);
while (my $res= $sth->fetch) {
	$global_word_list->{$res->[1]}->{ID}= $res->[0];
	$global_word_list->{$res->[1]}->{FREQ}= $res->[2];
	$global_word_list->{$res->[1]}->{OLDFREQ}= $res->[2];
}
$sth->finish;

##########################################################################################################################
# Extract new terms from unindexed content
##########################################################################################################################

my $dcount= 0;

my ($sth,$rv)= $dbh->get(['OBJECT'],['PK_OBJECT_ID'],'','OBJECT_INDEXED = "False"');
while (my $res= $sth->fetch and $dcount<$ndocs) {
	my $o= WiganRL::DataObject->new_notype($res->[0]);
	print "Object: $o, ".$o->id."\n";
	for (@{$o->search_fields}) {
		my %words= $t->get_words($o->param($_));
#		map {print "\t$_,$words{$_}\n"} keys %words;
		map {$global_word_list->{$_}->{FREQ}+= $words{$_}} keys %words;		
		my $nWords= keys %words;
		print "Found $nWords words.\n";
	}
	$dcount++;
}
$sth->finish;

##########################################################################################################################
# Update global word list
##########################################################################################################################

for (keys %$global_word_list) {
	if (defined $global_word_list->{$_}->{ID}) {
		if ($global_word_list->{$_}->{FREQ} != $global_word_list->{$_}->{OLDFREQ}) {
			$dbh->update('SEARCH_TERMLIST',['SEARCH_TERMFREQUENCY'],[$global_word_list->{$_}->{FREQ}],'PK_SEARCHTERM_ID="'.$global_word_list->{$_}->{ID}.'"');
			print "Updating: $_, ".$global_word_list->{$_}->{FREQ}."\n";
		}
	} else {
		my ($rv,$ins_id)= $dbh->insert('SEARCH_TERMLIST',['SEARCH_TERM','SEARCH_TERMFREQUENCY'],
			[[$_,$global_word_list->{$_}->{FREQ}]]);
		$global_word_list->{$_}->{ID}= $ins_id;
		print "Adding: $_, ".$global_word_list->{$_}->{FREQ}."\n";
	}
}

##########################################################################################################################
# Index content
##########################################################################################################################

my $dcount= 0;

my ($sth,$rv)= $dbh->get(['OBJECT'],['PK_OBJECT_ID'],'','OBJECT_INDEXED = "False"');
while (my $res= $sth->fetch and $dcount<$ndocs) {
	my $o= WiganRL::DataObject->new_notype($res->[0]);
	print "Object: $o, ".$o->id."\n";
	my $allwords= {};
	for (@{$o->search_fields}) {
		my %words= $t->get_words($o->param($_));
		map {$allwords->{$_}->{FREQ}+= $words{$_}} keys %words;		
	}
	$allwords= get_word_ids($allwords,$global_word_list);
	$allwords= norm_word_freq($allwords);
	my @arr= ();
	map {push @arr,$allwords->{$_}->{ID}; push @arr,$allwords->{$_}->{FREQ};} keys %$allwords;
	if ($#arr >= 0) {
		$dbh->replace('SEARCH_CONTENTINDEX',['FK_OBJECT_ID','SEARCH_CONTENTINDEX'],[[$o->id,join(',',@arr)]]);
	}
	$dbh->update('OBJECT',['OBJECT_INDEXED'],['True'],'PK_OBJECT_ID="'.$res->[0].'"');
	$dcount++;
}
$sth->finish;


exit(0);

#my $s= WiganRL::Search->new;
#$s->table('NEWS');
#$s->where();
#my $res= $s->search($ndocs);
#
#for (@$res) {
#	my $o= $_;
#	my $text= $o->param('NEWS_BODY');
#	$text=~ s/<[^>]*>//g;
##	print $text;
#
#	my %words= $t->get_words($text);
#
#	map {print "$_,$words{$_}\n"} keys %words;
#
#	map {$global_word_list{$_}+= $words{$_}} keys %words;
#}
#
#
##map {print "$_,$global_word_list{$_}\n"} keys %global_word_list;
#
#my %index;
#my @keys= keys %global_word_list;
#my $word_count= $#keys+1;
#for (my $i= 0; $i<$word_count; $i++) {
#	$index{$keys[$i]}= $i;
#}
#
#my %document_vectors;
#
#$res= $s->search($ndocs);
#for (@$res) {
#	my $text= $_->param('NEWS_BODY');
#	$text=~ s/<[^>]*>//g;
#
#	$document_vectors{$_->id}= make_vector($text);
#}
#
#my $threshold= 0.1;
#my $o= $s->search($ndocs+1)->[$ndocs];
#my $text= $o->param('NEWS_BODY');
#$text=~ s/<[^>]*>//g;
#
##print "Vector: ".make_vector($text)."\n";
#
#my %cosines= get_cosines( make_vector($text) );
#
#
#map {print "$_,$cosines{$_}\n"} (sort {$cosines{$b} <=> $cosines{$a}} keys %cosines);
#
#
#my $id= (sort {$cosines{$b} <=> $cosines{$a}} keys %cosines)[0];
#my $c= $cosines{$id};
#my $o2= WiganRL::DataObject::News->new($id);
#print "Word Count: $word_count\n";
##print "Doc1: \n".$o->param('NEWS_BODY')."\n\n";
##print "Doc2 $c: \n".$o2->param('NEWS_BODY')."\n\n";
##
##
##$text= "Wigan are in the Challenge Cup Final";
##$text= "Va'aiga Tuigamala";
##$text= "Andy farrell saracens";
##%cosines= get_cosines( make_vector($text) );
##my @id= sort {$cosines{$b} <=> $cosines{$a}} keys %cosines;
##map	{print "$_,$cosines{$_}\n"} (sort {$cosines{$b} <=> $cosines{$a}} keys %cosines);
##for (@id) {
##
##	$c= $cosines{$_};
##	$o2= WiganRL::DataObject::News->new($_);
##	my %words= $t->get_words( $text );
##	map {print "$_,$words{$_}\n"} keys %words;
##	print "Query: \n$text\n\n";#Vector: ".make_vector($text)."\n\n";
##	print "Doc2 $c: \n".$o2->param('NEWS_BODY')."\n\n";#."\nVector: ".$document_vectors{$o2->id}."\n\n";
##}
#
#
#
sub get_word_ids {
                my ( $doc ) = @_;
				my $words= shift;
				my $global_word_list= shift;
                foreach my $w ( keys %$words ) {
						if (exists $global_word_list->{$w}) {
	                        $words->{$w}->{ID} = $global_word_list->{$w}->{ID};
						}
                }
                return $words;
        }

sub norm_word_freq {
				my $words= shift;
				my $sum= 0;
                foreach my $w ( keys %$words ) {
	                  $sum+= $words->{$w}->{FREQ}*$words->{$w}->{FREQ};
                }
				if ($sum<=0) {
					return $words;
				}
                foreach my $w ( keys %$words ) {
	                  $words->{$w}->{FREQ}/= sqrt($sum);
                }
                return $words;
        }

#sub make_vector {
#                my ( $doc ) = @_;
#				my $words= shift;
#				my $global_word_list= shift;
#				my $len= keys %$global_word_list;
#                my $vector= ();
#                foreach my $w ( keys %$words ) {
#                        my $value = $words->{$w}->{FREQ};
#						if (exists $global_word_list->{$w}) {
#	                        my $offset = $global_word_list->{$w}->{ID};
#		                    $vector[$offset]= $value;
#						}
#                }
#                return $vector;
#        }
#
#sub cosine {
#                my ($vec1, $vec2 ) = @_;
#                my $n1 = norm $vec1;
#                my $n2 = norm $vec2;
#                my $cos = inner( $n1, $n2 );    # inner product
#                return $cos->sclr();  # converts PDL object to Perl scalar
#        }
#
#     sub get_cosines {
#                my ( $query_vec ) = @_;
#                my %cosines;
#                while ( my ( $id, $vec ) = each  %document_vectors ) {
#                        my $cosine = cosine( $vec, $query_vec );
#                        next unless $cosine > $threshold;
#                        $cosines{$id} = $cosine;
#                }
#                return %cosines;
#        }
#
#1;
#
#
